home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / setcolor.bas < prev    next >
Encoding:
BASIC Source File  |  2011-11-06  |  3.0 KB  |  106 lines
  1. DEFINT A-Z
  2.  
  3. DECLARE SUB SetColor ()
  4. DECLARE SUB LOCandCOLOR (Row, Col)
  5. DECLARE SUB LoyalPrint (S$)
  6.  
  7. 'You call this subroutine without any arguments to set the colors to whatever
  8. 'the current screen colors are at current location.  If you generally use
  9. 'LOCATE before every print statement then it makes much more sense to combine
  10. 'the two as I have done for LOCandCOLOR, thereby obviating the need to use
  11. 'those silly POS(0) and CSRLIN functions.  If you REALLY want to emulate
  12. 'QPrint, you need to do something like LoyalPrint, silly but effective.
  13. '       For my money, it makes sense in "most" instances to use the assembly
  14. 'printing functions from Crescent, MicroHelp or ProBAS but there are
  15. 'occasions when they are combersome, so I hope these help.
  16. 'Jonathan Zuck
  17. 'User Friendly, Inc.
  18. '202-387-1949
  19. 'CIS:17401,1305
  20. 'What follows is a small demonstration of the use of these subs...
  21.  
  22. CLS
  23. COLOR 0, 7
  24. FOR x = 1 TO 8
  25. PRINT SPACE$(80)
  26. NEXT x
  27. COLOR 7, 0
  28. FOR x = 1 TO 8
  29. PRINT SPACE$(80)
  30. NEXT x
  31. FOR x = 1 TO 8
  32. FOR y = 1 TO 4
  33. COLOR 0, 7
  34. PRINT SPACE$(10);
  35. COLOR 7, 0
  36. PRINT SPACE$(10);
  37. NEXT y
  38. PRINT
  39. NEXT x
  40.  
  41.  
  42. 'using SetColor
  43.  
  44. LOCATE 4, 10
  45. SetColor
  46. PRINT "This should be white on black"
  47.  
  48. 'using LOCandCOLOR
  49.  
  50. LOCandCOLOR 11, 10
  51. PRINT "And this is black on white"
  52.  
  53. 'using LoyalPrint
  54.  
  55. LOCATE 18, 7
  56. LoyalPrint "And THIS should make your eyes screem out loud for mercy!!!!"
  57. WHILE INKEY$ = "": WEND
  58.  
  59. SUB LOCandCOLOR (Row, Col)
  60. LOCATE Row, Col
  61. Attr = SCREEN(Row, Col, 1)              'By specifying a non-zero value in
  62.                                         'in the third position "colorflag"
  63.                                         'you get the color "attribute" rather
  64.                                         'than the ASCII number of the char
  65.                                         'at that position.
  66.  
  67. Fore = Attr MOD 16                      'This is the best method I know to
  68.                                         'parse the attribute into its
  69.                                         'colors.
  70. Back = ((Attr - Fore) / 16) MOD 123
  71. COLOR Fore, Back
  72. END SUB
  73.  
  74. SUB LoyalPrint (S$)
  75. L = LEN(S$)
  76. Row = CSRLIN
  77. Col = POS(0)
  78. FOR C = 1 TO L
  79. GOSUB SetColors
  80. PRINT MID$(S$, C, 1);
  81. NEXT
  82. PRINT
  83. EXIT SUB
  84. SetColors:
  85. Attr = SCREEN(Row, C + Col - 1, 1)
  86. Fore = Attr MOD 16
  87. Back = ((Attr - Fore) / 16) MOD 123
  88. COLOR Fore, Back
  89. RETURN
  90. END SUB
  91.  
  92. SUB SetColor
  93. Attr = SCREEN(CSRLIN, POS(0), 1)        'By specifying a non-zero value in
  94.                                         'in the third position "colorflag"
  95.                                         'you get the color "attribute" rather
  96.                                         'than the ASCII number of the char
  97.                                         'at that position.
  98.  
  99. Fore = Attr MOD 16                      'This is the best method I know to
  100.                                         'parse the attribute into its
  101.                                         'colors.
  102. Back = ((Attr - Fore) / 16) MOD 123
  103. COLOR Fore, Back
  104. END SUB
  105.  
  106.